Sub AutoCorrect_Macro()

Dim OrigWord As String
Dim RepWord As String
Dim x As String
Dim objExcel As Object

Dim auto_ctr As Integer
Dim highlight_ctr As Integer
Dim RedFont_ctr As Integer
Dim BlueFont_ctr As Integer

Dim xx As Integer

xx = MsgBox("Do you want to proceed with Auto-Correct function?", vbYesNo + vbExclamation, "AUTO-CORRECT")

If xx = 6 Then


Set objExcel = CreateObject("Excel.Application")
Set exWb = objExcel.Workbooks.Open("W:\Training\TRAINEES\MACROS\New Macro\msWord_AutoCorrect Macro.xlsx", ReadOnly:=True)

'AUTOCORRECT FUNCTION

auto_ctr = exWb.sheets("AutoCorrect").Cells(1, "B")

Options.DefaultHighlightColorIndex = wdBrightGreen

For i = 7 To auto_ctr

   OrigWord = exWb.sheets("AutoCorrect").Cells(i, 2)
    RepWord = exWb.sheets("AutoCorrect").Cells(i, 3)
    
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Font.Reset
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Text = OrigWord
        .Replacement.Text = RepWord
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = True
        .MatchWholeWord = True
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

Next

exWb.Close

MsgBox "Process Complete!", vbOKOnly + vbInformation, "Information"

End If


End Sub



Sub WordCheck()

Dim OrigWord As String
Dim RepWord As String
Dim x As String
Dim objExcel As Object

Dim auto_ctr As Integer
Dim highlight_ctr As Integer
Dim RedFont_ctr As Integer
Dim BlueFont_ctr As Integer


'clear search pain to avoid unintended character omission
With Selection.Find
   .ClearFormatting
   .Replacement.ClearFormatting
   .Text = ""
   .Replacement.Text = ""
   .Forward = True
   .Wrap = wdFindStop
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchWildcards = False
   .MatchSoundsLike = False
   .MatchAllWordForms = False
End With


Set objExcel = CreateObject("Excel.Application")
Set exWb = objExcel.Workbooks.Open("W:\Training\TRAINEES\MACROS\New Macro\msWord_AutoCorrect Macro.xlsx", ReadOnly:=True)



''HIGHLIGHT ONLY FUNCTION''''''''''''''''''''''''''''''''''''''''

auto_ctr = exWb.sheets("HighlightOnly").Cells(1, "B")

Options.DefaultHighlightColorIndex = wdYellow

For i = 7 To auto_ctr

    OrigWord = exWb.sheets("HighlightOnly").Cells(i, 2)
        
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Font.Reset
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Text = OrigWord
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

Next

'HIGHLIGHT ONLY FUNCTION - CASE SENSITIVE

auto_ctr = exWb.sheets("HighlightOnly").Cells(1, "D")

Options.DefaultHighlightColorIndex = wdYellow

For i = 7 To auto_ctr

    OrigWord = exWb.sheets("HighlightOnly").Cells(i, 4)
        
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Font.Reset
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Text = OrigWord
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

Next

'For WILDCARDS - HIGHLIGHT ONLY

auto_ctr = exWb.sheets("HighlightOnly").Cells(1, "F")

Options.DefaultHighlightColorIndex = wdYellow

For i = 7 To auto_ctr


    OrigWord = exWb.sheets("HighlightOnly").Cells(i, 6)
        
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Font.Reset
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Text = OrigWord
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

Next




''RED FONT FUNCTION'''''''''''''''''''''''''''''''''''''''''

auto_ctr = exWb.sheets("RedFont").Cells(1, "B")

For i = 7 To auto_ctr

OrigWord = exWb.sheets("RedFont").Cells(i, 2)

Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Font.Reset
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = wdColorRed
    With Selection.Find
        .Text = OrigWord
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
Next

''RED FONT FUNCTION - CASE SENSITIVE

auto_ctr = exWb.sheets("RedFont").Cells(1, "D")

For i = 7 To auto_ctr

OrigWord = exWb.sheets("RedFont").Cells(i, 4)

Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Font.Reset
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = wdColorRed
    With Selection.Find
        .Text = OrigWord
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
Next


''ITALIC COMMA FUNCTION - RED FONT

Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Font.Reset
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = wdColorRed
    With Selection.Find
        .Text = ","
        .Replacement.Text = ""
        .Forward = True
        .Font.Italic = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    
    
'For WILDCARDS - RED FONT

auto_ctr = exWb.sheets("RedFont").Cells(1, "F")

'Options.DefaultHighlightColorIndex = wdYellow

For i = 7 To auto_ctr

    OrigWord = exWb.sheets("RedFont").Cells(i, 6)
        
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Font.Reset
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Text = OrigWord
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

Next
    
    
    

''BLUE FONT FUNCTION'''''''''''''''''''''''''''''''''''''''''''

auto_ctr = exWb.sheets("BlueFont").Cells(1, "B")

For i = 7 To auto_ctr

OrigWord = exWb.sheets("BlueFont").Cells(i, 2)

Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Font.Reset
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = wdColorBlue
    With Selection.Find
        .Text = OrigWord
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
Next

''BLUE FONT FUNCTION - CASE SENSITIVE

auto_ctr = exWb.sheets("BlueFont").Cells(1, "D")

For i = 7 To auto_ctr

OrigWord = exWb.sheets("BlueFont").Cells(i, 4)

Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Font.Reset
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = wdColorBlue
    With Selection.Find
        .Text = OrigWord
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
Next


'For WILDCARDS - BLUE FONTS

auto_ctr = exWb.sheets("BlueFont").Cells(1, "F")

'Options.DefaultHighlightColorIndex = wdYellow

For i = 7 To auto_ctr

    OrigWord = exWb.sheets("BlueFont").Cells(i, 6)
        
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Font.Reset
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Text = OrigWord
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

Next

'close source excel file
exWb.Close

MsgBox "Process Complete!", vbOKOnly + vbInformation, "Information"

End Sub



Sub RemoveHighlight()

Dim x As Integer

x = MsgBox("Highlighting will be removed & Font Color will be set to Automatic. Do you want ot continue?", vbYesNo + vbInformation, "Clear Highlight & Font Color")

If x = 6 Then
    Selection.WholeStory
    Selection.Range.HighlightColorIndex = wdNoHighlight
    Selection.Font.Color = wdColorAutomatic
    Selection.Collapse direction:=wdCollapseEnd
    Selection.HomeKey Unit:=wdStory
    
    MsgBox "Process Complete!", vbOKOnly + vbInformation, "Information"
    
End If


End Sub
